home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / acorrmat.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  3.6 KB  |  120 lines
  1. 100 CLS:PRINT"Program CLUSTER.BAS - to cluster NSET sets of data with NOBS"
  2. 110 PRINT"         observations in each set (HARD DISK VERSION).":PRINT
  3. 120 PRINT SPC(20);"Deane Wang - Cybersoft Group   (Ver. 3/83)"
  4. 130 PRINT STRING$(80,"=")
  5. 140 '
  6. 150 OPTION BASE 1
  7. 155 DIM MA(40,100), NX(100), NY(100)
  8. 160 INPUT"Enter input dataset name";INA$
  9. 170 OPEN INA$ FOR INPUT AS #1
  10. 180 GOSUB 1000  'read in data, set up array MA(NSET,NOBS)
  11. 190 CLOSE #1
  12. 195 CLOSE #3: OPEN "SCRN:" FOR OUTPUT AS #3: N=NOBS
  13. 200 GOSUB 3000  '(CORR.BAS subroutine)
  14. 240 END
  15. 1000 REM
  16. 1010 PRINT:PRINT "Subroutine READAT.BAS - to read in data as MA(NSET,NOBS)"
  17. 1020 PRINT STRING$(70,"*"):PRINT
  18. 1030 '
  19. 1040 INPUT "Enter the number of sets of data (max. 40)";NSET
  20. 1050 INPUT "Enter the number of observations in each set (max. 100)";NOBS
  21. 1060 FOR I=1 TO NSET
  22. 1070   FOR J=1 TO NOBS
  23. 1080   INPUT#1,MA(I,J)
  24. 1090   NEXT J
  25. 1100 NEXT I
  26. 1120 RETURN
  27. 3000 REM
  28. 3010 PRINT:PRINT"Subroutine CORR.BAS - to take MA(NSET,NOBS) entered in the"
  29. 3020 PRINT "Main program and create a correlation matrix in C:CORRMAT.DAT."
  30. 3030 PRINT "Uses subroutine REGRESS.BAS, option base 1 in Main"
  31. 3040 PRINT STRING$(70,"*"):PRINT
  32. 3050 LCNT=0: RFLAG=0
  33. 3060 INPUT "Enter a 0 for R, 1 for r-squared";RFLAG
  34. 3070 CLOSE #2: OPEN "C:CORRMAT.DAT" FOR OUTPUT AS #2
  35. 3080 PRINT: PRINT "Calculating pairs ";
  36. 3085 IF RFLAG=1 THEN PRINT "for r-squares:" ELSE PRINT "for r:"
  37. 3090 IF RRR=1 THEN 3110 ELSE RRR=1
  38. 3100 '
  39. 3110 FOR IJ=1 TO (NSET-1)
  40. 3120   FOR J=IJ+1 TO NSET
  41. 3130     FOR K=1 TO NOBS
  42. 3140       NX(K)=MA(IJ,K): NY(K)=MA(J,K)
  43. 3150     NEXT K
  44. 3160     GOSUB 5000  'regression subroutine for individual nx, ny's
  45. 3170     IF RFLAG=0 THEN R2=SQR(R2)   'matrix of r (correlation coef)
  46. 3180     LCNT=LCNT+1
  47. 3190     PRINT#2,USING "##.####";R2;
  48. 3200     IF LCNT=10 THEN LCNT=0: PRINT#2,
  49. 3210     PRINT " *";:PRINT USING "###";IJ;J;
  50. 3215   NEXT J: PRINT
  51. 3220 NEXT IJ
  52. 3230 CLOSE #2: RETURN
  53. 5000 '
  54. 5010 REM  LINEAR REGRESSION OF Y ON X - SUBROUTINE
  55. 5020 '
  56. 5030 '  NEED IN THE MAIN PROGRAM:
  57. 5040 '
  58. 5050 '    n = number of observations
  59. 5060 '    dim nx(n), ny(n)
  60. 5070 '    open "scrn:" for output as #3
  61. 5080 '
  62. 5090 '  INITILIZE SUMS
  63. 5100 '
  64. 5110 XSUM=0!: YSUM=0!  'sums
  65. 5120 XSS=0!: YSS=0!    'sums of squares
  66. 5130 XYS=0!            'sum of x*y
  67. 5140 A=0!: B=0!: R2=0!
  68. 5150 '
  69. 5160 '  CALCULATE SUMS, SUMS SQUARES, SUM X*Y
  70. 5170 '
  71. 5180 FOR I=1 TO N
  72. 5190   XSUM=NX(I)+XSUM
  73. 5200   XSS=NX(I)*NX(I)+XSS
  74. 5210   YSUM=NY(I)+YSUM
  75. 5220   YSS=NY(I)*NY(I)+YSS
  76. 5230   XYS=NX(I)*NY(I)+XYS
  77. 5240 NEXT I
  78. 5250 '
  79. 5260 '  CALCULATE SLOPE(B), INTERCEPT(A), R**2 (R2)
  80. 5270 '
  81. 5280 XSUM2=XSUM*XSUM
  82. 5290 YSUM2=YSUM*YSUM
  83. 5300 XSYS=XSUM*YSUM
  84. 5310 BN=XYS-(XSYS/N)
  85. 5320 BD=XSS-(XSUM2/N)
  86. 5330 B=BN/BD
  87. 5340 AI=YSUM/N
  88. 5350 ASS=B*(XSUM/N)
  89. 5360 A=AI-ASS
  90. 5370 RD2=YSS-(YSUM2/N)
  91. 5380 R2=BN*BN/(BD*RD2)
  92. 5390 '
  93. 5395 RETURN  'skip printing out for this version
  94. 5400 '  CALCULATE USUAL STATISTICS
  95. 5410 '
  96. 5420 XBAR=XSUM/N
  97. 5430 XDEV=SQR(BD/(N-1))
  98. 5440 YBAR=YSUM/N
  99. 5450 YDEV=SQR(RD2/(N-1))
  100. 5460 SQN=SQR(N)
  101. 5470 XERR=XDEV/SQN
  102. 5480 YERR=YDEV/SQN
  103. 5490 '
  104. 5500 '  PRINT OUT RESULTS
  105. 5510 '
  106. 5520 PRINT#3,: PRINT#3,"A =";A
  107. 5530 PRINT#3,"B =";B
  108. 5540 PRINT#3,"R-squared =";R2
  109. 5550 PRINT#3,"# observations =";N
  110. 5560 PRINT#3,
  111. 5570 PRINT#3,"Mean of X =";XBAR,"  Std. Dev. =";XDEV,"  Std.Err. =";XERR
  112. 5580 PRINT#3,"Mean of Y =";YBAR,"  Std. Dev. =";YDEV,"  Std.Err. =";YERR
  113. 5590 PRINT#3,
  114. 5600 PRINT#3,"Sum of X =";XSUM,"  Sums of squares =";XSS
  115. 5610 PRINT#3,"Sum of Y =";YSUM,"  Sums of squares =";YSS
  116. 5620 PRINT#3,"Sum of X * Y =";XYS
  117. 5630 RETURN
  118. s of squares =";XSS
  119. 5610 PRINT#3,"Sum of Y =";YSUM,"  Sums of squares =";YSS
  120. 5620 PRINT#3